home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / 1svga.zip / FONTS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-18  |  2KB  |  75 lines
  1. { Show all fonts XXYYnnn#.fnt }
  2.  
  3. uses Dos,SVGA256,Txt;
  4.  
  5. var FontFiles:array[0..2047] of string[12];
  6.     Max:integer;
  7.  
  8. { ─────────────── GetFontFiles ─────────────── }
  9. procedure GetFontFiles(Path:string);
  10. var DirInfo:SearchRec;
  11.     St:string[12];
  12. begin
  13.   Max:=0;
  14.   FindFirst(Path,Archive,DirInfo);
  15.   while DosError=0 do begin
  16.     St:=DirInfo.Name;
  17.     if (St[1]<='9') and (St[1]>='0') then
  18.       begin FontFiles[Max]:=St; Inc(Max); end;
  19.     FindNext(DirInfo);
  20.   end;
  21.   if Max=0 then begin Writeln('Fonts not found !'); Halt(1); end;
  22.   Dec(Max);
  23. end;
  24. { ─────────────── ShowFonts ─────────────── }
  25. procedure ShowFonts;
  26. const C:array[1..2] of byte=(104,54);
  27. var Buf:pointer;
  28.     I,K,P,X,X0,Y,Size,Count,Col,FontType:integer;
  29.     St,St2:string[12];
  30.     Font1:array[0..767] of byte;
  31. begin
  32.   GetMem(Buf,20000);
  33.   Bar(0,0,320,8,C[2]); Bar(0,8,320,184,C[1]); Bar(0,192,320,8,C[2]);
  34.   FileRead('0808sim#.fnt',0,96,8,Font1);
  35.   InstallFont(2,8,8,32,96,8,Font1);
  36.   Print2(8,0,64,'Show all fonts');
  37.   Print2(8,192,64,'Cursors,PgUp,PgDn,Home,End-Select a font');
  38.   P:=0; Str(Max+1,St2); St2:='/'+St2;
  39.   repeat
  40.     St:=FontFiles[P];
  41.     if Pos('#',St)=0 then FontType:=1 else FontType:=2;
  42.     Val(Copy(St,1,2),X,I);
  43.     Val(Copy(St,3,2),Y,I);
  44.     X0:=X; if X=9 then X:=8; X:=(X+7) shr 3 shl 3;
  45.     Size:=X*Y shr 3; Count:=FileLen(St,Size); Col:=304 div X;
  46.     FileRead(St,0,Count,Size,Buf^);
  47.     InstallFont(2,8,8,32,96,8,Font1);
  48.     Bar(160,0,160,8,C[2]);
  49.     Print2(160,0,80,St); Str(P+1,St); Print2(264,0,92,St+St2);
  50.     Bar(0,8,320,184,C[1]);
  51.     InstallFont(1,X,Y,0,Count,X,Buf^);
  52.     for I:=0 to Count-1 do
  53.       Print(X*(I mod Col)+8,Y*(I div Col)+12,64+I mod 32,Chr(I));
  54.     if Count=96 then InstallFont(FontType,X,Y,32,Count,X0,Buf^)
  55.       else if Count=256 then InstallFont(FontType,X,Y,0,Count,X0,Buf^)
  56.       else InstallFont(FontType,X,Y,97,Count,X0,Buf^);
  57.     PrintColor(1,8,140,  64,1,'Pet Shop Boys/Very');
  58.     PrintColor(1,8,140+Y,80,1,'Can you forgive her?');
  59.     K:=Key;
  60.     case K of
  61.       $4800:Dec(P);   $5000:Inc(P);      { Up, Down }
  62.       $4900:Dec(P,5); $5100:Inc(P,5);    { PgUp, PgDn }
  63.       $4700:P:=0;     $4F00:P:=Max;      { Home, End }
  64.     end;
  65.     if P<0 then P:=Max; if P>Max then P:=0;
  66.   until K=$011B;
  67.   FreeMem(Buf,20000);
  68. end;
  69.  
  70. begin
  71.   GetFontFiles('*.fnt');
  72.   SetMode(1); ShowFonts;
  73.   SetMode(0);
  74. end.
  75.